home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbsub10.arc / LMENU.SUB < prev    next >
Encoding:
Text File  |  1986-06-25  |  3.8 KB  |  101 lines
  1. ' LMENU.SUB -- MSDOS QuickBASIC line menu subroutines    15 June 86
  2. '        by David L. Poskie     (608) 274-9560
  3. '                  7118 Raymond Rd. Madison, WI 53719
  4. ' Please run any suggestions, corrections, additions, or changes by me.
  5. ' I can be messaged on all the major Madison, WI RBBS's.
  6.  
  7. '| These subroutines require the main program to $Include: 'OMNI.SUB'.
  8. '|   Subroutines:
  9. '|        LoadLMenu   -- Load the line menu array    
  10. '|        LMenu        -- Set a line menu and get response
  11. '| Line Menu Procedures: 
  12. '| Read up to 11 one-line menus, up to 9 selections per menu from DATA lines
  13. '|  located in the calling program. 
  14. '| Load menus in Menu$(n,n) by GOSUB LoadLMenu , returns LMenuMax = # of menus.
  15. '| LOCATE cursor before calling menu, then call a menu by:
  16. '|   setting Num = (0 to 10) : GOSUB LMenu -- evaluate KeyCode on RETURN.
  17. '| Quit will always return KeyCode = -21. I use this number because <ESC> also
  18. '|   returns -21.  Thus, you can bail out of a menu with <ESC>. No other
  19. '|   evaluation is made -- you will get any out of bounds numbers and must
  20. '|   check for these in the main program.
  21. '|
  22. '| Saves foreground & background colors, restoring them after input.
  23. '|
  24. '| Input: KeyCode = ASCII Inkey$ code input by user
  25.  
  26. '| Output: LMenuMax = Total number of line menus loaded from LMenu DATA
  27. '|       KeyCode -- adjusted to track with selection number
  28. '|       NumSelects() = number of selections in a given line menu
  29. '| Other Vars: Blank -- does internal spacing for LMenu layout
  30. '|           LMenuNum = specific line menu
  31. '|           Menu$() = array of line menus
  32. '|           Num -- count of line menus in Menu$()    
  33. '|           Selection = individual selection in Menu$()
  34. '|           Temp -- temporary count    
  35. '|           TestFG = foreground color to be restored
  36. '|           TestBG = background color to be restored
  37.  
  38.     ' Subroutine to read DATA into Menu$(Num , Selection),
  39.     '   loading all the menus and prompts.
  40. LoadLMenu:
  41.     RESTORE LMenuData            ' In case the pointer is 
  42.     FOR Num = 0 TO 10            '   somewhere else
  43.         FOR Selection = 0 TO 10
  44.         READ Menu$(Num , Selection)
  45.         ' Look for end of ONE menu symbol
  46.         IF Menu$(Num , Selection) = "*"                _
  47.            THEN NumSelects(Num) = Selection - 1 :        _
  48.             GOTO LoadLMenuLoop 
  49.         ' NumSelects(Num) holds number of selections
  50.         ' Look for end of ALL menus symbol
  51.         IF Menu$(Num , Selection) = "$"                _
  52.            THEN LMenuNum = Num - 1 :                _
  53.         GO TO LoadLMenuExit
  54.         NEXT Selection
  55.     ' One Menu is read
  56. LoadLMenuLoop:
  57.     NEXT Num
  58.     ' All Menus are read
  59. LoadLMenuExit:
  60.     LMenuMax = Num - 1        ' Maximum number of menus
  61. RETURN
  62.     '_____________________________________________________________________
  63.  
  64.     'Subroutine to print the menu line and get a response
  65. LMenu:
  66.     ' Read foreground color
  67.     TestFG = ((SCREEN (1 , 1 , 1)) MOD 16)
  68.     ' Read background color
  69.     TestBG = (((SCREEN (1 , 1 , 1)) - TestFG) / 16) MOD 128
  70.     ' Set blank space between selections
  71.     Blank = 0
  72.     FOR Temp = 0 TO NumSelects(Num)
  73.         Blank = Blank + LEN(STR$(Temp)) + LEN(Menu$(Num , Temp)) + 2
  74.     NEXT Temp
  75.     Blank = INT((80 - Blank) / NumSelects(Num) - 1)
  76.     ' Case of a negative number
  77.     IF Blank < 0                            _
  78.        THEN Blank = 0
  79.     ' Case of protecting Blank = 1
  80.     IF Blank > 1                             _
  81.        THEN Blank = INT(Blank / 2)
  82.     ' Print menu line
  83.     COLOR 0 , 7
  84.     FOR Temp = 1 TO NumSelects(Num)
  85.         PRINT SPC(Blank); STR$(Temp); SPC(Blank); Menu$(Num , Temp); " █";
  86.     NEXT Temp
  87.     ' Print prompt and get menu selection
  88.     COLOR 31 , 0
  89.     PRINT " « ";
  90.     COLOR 15
  91.     PRINT Menu$(Num , 0);
  92.     GOSUB GetKeyClear
  93.     KeyCode = KeyCode - 48            ' Adjust to track with number
  94.     ' Make any Quit Command = -21
  95.     IF KeyCode = NumSelects(Num)                    _
  96.        THEN KeyCode = -21            ' Allows bailout on <ESC>
  97.     ' Restore colors & go
  98.     COLOR TestFG , TestBG
  99. RETURN
  100. ' >>>>> Physical EOF LMENU.SUB  18 June 86
  101.